perm filename DISXGP.FAI[NEW,LCS]1 blob sn#267323 filedate 1977-03-21 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FILLMS  
C00026 ENDMK
C⊗;
	TITLE FILLMS  
	ENTRY FILLMS,DST,LL,LINES,NOIR,PLOTS
	EXTERNAL DPY,.COMM.,ROFF,XRN,SQRT,PLOT
	EXTERNAL DL,PLTR,STF,ALF,UNPACK
DEFINE R9< .COMM.+=10>
RINP:	BLOCK =900
DST:	0.005  		;BB  CHANGE DIST2,3,4 TO JFCL FOR DISTORTION.
	1.8		;CC  ALSO CHANGE DIST1(LINXGP) TO JRST DIST.
LL:	0
	KK←2 ↔ L←3 ↔ C←4 ↔ D←5 ↔ J←1
	RL←6 ↔ RJ←7 ↔ Z←0 ↔ X←11 ↔ JK←10
	HG←12 ↔ Y←13 ↔ AL←14 ↔ JJ←15
;******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
;	SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
;	COMMON/DL/RSIZ,SAVER,NAME
;	COMMON/DST/BB,CC/FLM/X(600)
;	DIMENSION IDAT(1),NX(600)
;	EQUIVALENCE (NX,X)
;	COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY   MP=PLOTTER   MX=XGP
;	DATA M2/2/
FILLMS:	0
	MOVE PLTR+2		;
	MOVEM DX#		;	DX=DIS
	MOVE PLTR+1		;	RX=RHT
	MOVEM RX#
	MOVE @4(16)		;	D=RSTJ2*R6
	FMPR STF+10
	MOVEM D#
	MOVE @5(16)		;	R=RSTJ2*R7
	FMPR STF+10
	MOVEM R#
DIST2:	SKIPGE R9		;DISTORT IF R9.GE.0
	JRST FM1		;GO TO 1
	MOVE DST+1
	MOVEM C#		;	C=CC
	MOVE DST		;	B=BB
	MOVEM B#		;  SAVES IT.  IT WILL RETURN LATER.
	FDVR PLTR+2		;	BB=B/DIS
	MOVEM DST
	MOVE [1000.0]		;	CC=1000
	MOVEM DST+1
FM1:	MOVNI 13,2		;1	KK=-2
        SETZ 7,        		;  KK IS 13,  J IS 7	DO 205 J=1,L
	MOVEI 12,@1(16)		;LOC OF IDAT
FM205:	ADDI 13,3		;	KK=KK+3
				;	KX=KK+2
	JSA 16,UNPACK	 	; CALL UNPACK(M,N,IDAT(J))
	4			;X COORD.
	5			;Y COORD.
	(12)			;	;  12 IS IDAT ARRAY
	AOJ 12,			; UPDATE POINTER
	MOVEM 1,RINP+1(13)	; LL (=2 PEN DN., =3 PEN UP.)
	FLTR 4 			;	X(KK)=(R2+D*M)*DIS
	FMPR D			;CC	X(KK)=ROFF((R2+D*M)*DIS)
	FADR @2(16)
	FMPR PLTR+2
	MOVEM RINP-1(13)	; X COORD.
	FLTR 5  			;CC	X(KK+1)=ROFF((CENTR+R*N)*RHT)
	FMPR R			;	X(KK+1)=(CENTR+R*N)*RHT
	FADR @3(16)
	FMPR PLTR+1
	MOVEM RINP(13)		; Y COORD.
DIST3:	SKIPGE R9
	JRST FM3 		;3	GO TO 205
	MOVM RINP-1(13)
	FMPR DST		;	X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
	MOVNS			;C  FOR DISTORTION
	FADR C
	FMPRM RINP(13)
	
FM3:	AOJ 7,			;205	CONTINUE
	CAME 7,@(16)
	JRST FM205
	ADDI 13,2		;	NX(3)=KX
	MOVEM 13,RINP+2
	MOVSI 201400
	MOVEM PLTR+2		;	DIS=1.0
	MOVEM PLTR+1		;	RHT=DIS
;;	MOVEI 10,1		;	IF(IPLT)M=RSIZ+.4
	MOVE [1.7]		;	IF(M.LE.0)M=1
	CAMG  DL		;	IF(M.GT.M2)M=M2
	JRST CALCMP		;USE OLD FILLER. SAVES PEN TIME.

		;	SUBROUTINE FILLER(QQ,MD)
		;	COMMON /RINP/I(1) /ALF/NO,H(72) /PLTR/P,RHT,DIS
		;	DIMENSION Q(1)
		;  H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
;FILLER:	0		;	EQUIVALENCE (Q,I),(KNT,I(3))
	MOVE RINP		;	RL=Q(1)
	MOVEM LEFT#		; FLOATING!
	MOVEM RIGHT#		;	RR=RL
	SETZ 2,			;	DO 1 K=1,KNT,3
FL1:	MOVE RINP+2(2)		;CC	Q(K)=IFIX(Q(K))
	CAIN 3			;CC	Q(K+1)=IFIX(Q(K+1))
	SETOM RINP+2(2)		;DO THIS ABOVE?	IF(I(K+2).EQ.3)I(K+2)=-1

	MOVE RINP(2)		;	A=Q(K)
	CAMN RINP+3(2)		;	IF(Q(K+3).EQ.A)I(K+5)=-1
	SETOM RINP+5(2)		;C VERTICAL LINES WILL BE IGNORED.
	CAMGE LEFT		;	IF(RL.GT.A)RL=A
	MOVEM LEFT
	CAMLE RIGHT		;1	IF(RR.LT.A)RR=A
	MOVEM RIGHT		;C GET LEFT AND RIGHT EXTREME LIMITS.
	ADDI 2,3		;K=K+3
	CAMGE 2,RINP+2		;I(3)
	JRST FL1
	
	MOVN [0.5]		;	RR=RR-.5
	FADRM LEFT		;	RL=RL-.5
FL2:	MOVSI 201400		;2	RL=RL+1
	FADRB LEFT		;C SLICE COUNTER
	CAML RIGHT		;	IF(RL.GT.RR)RETURN
	JRST FM6		;JRA 16,2(16)
	SETZ 11, 		;	M=0
	MOVEI 2,3		;	DO 3 J=4,KNT,3
FL3:	SKIPGE RINP+2(2)		;	IF(I(J+2))GO TO 3
	JRST FLX3
	MOVE RINP(2)		;A	IF(IHORZ(I,J,RL))GO TO 3
	MOVE 1,RINP-3(2)	;B	C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
	CAML 0,1		;	FUNCTION IHORZ(Q,J,RL)
	EXCH 0,1		;	DIMENSION Q(1)
	CAML 0,LEFT		;	IHORZ=-1
	JRST FLX3		;	A=Q(J)
	CAMG 1,LEFT 		;	B=Q(J-3)
	JRST FLX3		;PREVIOUS X COORD. IF(A.GT.B)CALL EXCH(A,B)
	AOJ 11,			;	IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
	             		;	M=M+1
				;	H(M)=HGT(J,RL,I)
	MOVE 3,RINP+1(2)		;	FUNCTION HGT(J,RL,Q)
	FSBR 3,RINP-2(2)		;	DIMENSION Q(1)
	MOVE LEFT		;	HGT=Q(J-2)
	FSBR RINP-3(2)		;C  PREVIOUS Y COORD.
	FMPR 3,0		;	A=Q(J-3)
	MOVE RINP(2)		;C  PREVIOUS X COORD.
	FSBR RINP-3(2)		;	HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
	FDVR 3,0		;CAN HAVE A DIVIDE BY ZERO HERE!!
	FADR 3,RINP-2(2)		;3	CONTINUE
	MOVEM 3,ALF(11)		;H(M)
FLX3:	ADDI 2,3
	CAMGE 2,RINP+2
	JRST FL3
	JUMPE 11,FL2		;	IF(M.EQ.0)GO TO 2
	          		;C  M=0=SPACE BETWEEN OBJECTS -- NO FILLER
	MOVEI 2,1		;	J=1
FL5:	MOVE ALF(2)		;5	IF(H(J).GE.H(J+1))GO TO 4
	CAML ALF+1(2)		;C  SORTS HEIGHTS
	JRST FL4		;	CALL EXCH(H(J),H(J+1))
	EXCH 0,ALF+1(2)
	MOVEM ALF(2)
	CAIN 2,1		;	IF(J.EQ.1)GO TO 4
	JRST FL4
	SOJ 2,			;	J=J-1
	JRST FL5		;	GO TO 5
FL4:	AOJ 2,			;4	J=J+1
	CAMGE 2,11		;	IF(J.LT.M)GO TO 5
	JRST FL5		;C GO BACK IF MORE SORTING TO BE DONE
	MOVEI 14,1		;	NN=1
FL6:	MOVE 13,ALF(14)		;CCCCC6	IF(H(NN).EQ.H(NN+1))GO TO 7
	MOVE 12,ALF+1(14)	;	A=H(NN)
	MOVE 13          	;	B=H(NN+1)
	FSBR 12
	CAMG [1.0]		;   IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
	JRST FL7
	FSBR 13,[1.0]
	FADR 12,[1.0]		;A IS 13,  B IS 12
	JSA 16,LINES
	JUMP LEFT
	JUMP 13
	JUMP [3]
	JSA 16,LINES
	JUMP LEFT
	JUMP 12
	JUMP [2]
FL7:	ADDI 14,2		;7	NN=NN+2
	CAMGE 14,11		;C SKIP BY 2'S
	JRST FL6		;	IF(NN.LT.M)GO TO 6
	JRST FL2		;	GO TO 2

FM6:	MOVE DX			;2	CALL FILLER(NX,M)
	MOVEM PLTR+2		;	DIS=DX
	MOVE RX			;	RHT=RX
	MOVEM PLTR+1
DIST4:	SKIPGE R9
	JRA 16,6(16)		;5	RETURN
	MOVE B			;C  NEXT TO RESET DISTORTION FACT.
	MOVEM DST		;	BB=B
	MOVE C			;	CC=C
	MOVEM DST+1
	JRA 16,6(16)		; 	RETURN

INCR:	2	;FILLS EVERY OTHER SLICE LINE ON PLOTTER.
				;	SUBROUTINE FILLER(Q,M)
CALCMP:	HRRZI J,RINP
	HRRZM J,SVQ#
	MOVEM 16,SV16#
	HRRZ KK,2(J)
	ADDI KK,-1(J)		;	DO 4 K=2,KK
	HRRZI L,2(J)		;	IF(NE(K).NE.3)GO TO 11
L4:	ADDI L,3
	HRRZ D,(L)
L11:	SETZM (L)
	CAIN D,3		;	NE(K)=-1
      	SETOM (L)		;	GO TO 4
				; 11	NE(K)=0
				; 4	CONTINUE
	CAIGE L,(KK)
	JRST L4
	MOVE RL,(J)     	;	CCC RLFT=10000    RL=Q(1)
	MOVE RJ,RL        	;	CCC RT=-10000     RT=RL
	MOVE Z,RJ		;	Z=RT
	HRRZI L,-3(J)		;	DO 12 K=1,KK
L12:	ADDI L,3       		;	X=IFIX(Q(K))
	KIFIX X,(L)
	FLTR X,X		;KL10 FLOAT
				;	IF(X.LT.RLFT)RLFT=X
	CAMGE X,RL
	MOVE RL,X		;	IF(X.GT.RT)RT=X
	CAMLE X,RJ
	MOVE RJ,X		;	IF(X.EQ.Z)NE(K)=-1
	CAMN X,Z
	SETOM 2(L)		;	Z=X
	MOVE Z,X		;	Q(K)=X
	MOVEM X,(L)		; 12    R(K)=IFIX(R(K))
	KIFIX D,1(L)
	FLTR D,D
	MOVEM D,1(L)
	CAIGE L,-2(KK)
	JRST L12		;	NE(KK+1)=-1
	SETOM 3(KK)		;	LRT=RT
	KIFIX RJ,RJ
	MOVEM RJ,LRT#		;	JA=3
	HRRZI D,3
	HRRZM D,JA#		; 124   LEFT=RLFT
L124:	KIFIX C,RL		; 51    J=LEFT
L51:	MOVE J,C		; 42    RJ=J+.001
L42:	FLTR RJ,J		;FLOAT J, PUT IT IN RJ
	FADR RJ,[=0.001]	;	JCONT=0
	SETZM JCONT#		;	LEFT=J
	MOVE C,J		;	JJ=-1
	SETO JJ,		;	ALT=-10000.
	MOVN AL,[=10000.0] 	; 200   DO 45 L=2,KK
	HRRZ  L,SVQ 
L45:	ADDI L,3
	CAILE L,-2(KK)
	JRST L455		;	IF(NE(L).NE.0)GO TO 45
	SKIPE 2(L)
	JRST L45		;	IF(MISS(L,RJ,Q))GO TO 45
	CAML RJ,-3(L)
	JRST L201
	CAMLE RJ,(L)
	JRST L202
L201:	CAMGE RJ,(L)
	CAMG RJ,-3(L)
	JRST L45		;	X=HGHT(L,RJ,Q,R)
L202:	MOVE X,-2(L)
	CAMN X,1(L)
	JRST RET
	MOVNS X
	FADR X,1(L)
	MOVE Y,-3(L)
	MOVNS D,Y
	FADR D,RJ
	FADR Y,(L)
	FMPR X,D
	FDVR X,Y
	FADR X,-2(L)		;	IF(X.LT.ALT)GO TO 45
RET:	CAMGE X,AL
	JRST L45		;	ALT=X
	MOVE AL,X		;	JJ=L
	HRRZI JJ,(L)		; 45    CONTINUE
	JRST L45		;	IF(JJ)GO TO 43
L455:	JUMPL JJ,L43		;	JCONT=-1
	SETOM JCONT		;	LEFT=J
	MOVE C,J		; 46    JA=3
L46:	HRRZI D,3
	HRRZM D,JA		;	JORD=-1
	SETOM JORD#		; 52    KN=Q(JJ)
L52: 	KIFIX D,(JJ)
	MOVEM D,KN#		;	KL=Q(JJ-1)
	KIFIX D,-3(JJ)

	MOVEM D,KL#		;	IF(KN.LT.KL)KN=KL
	CAMLE D,KN
	MOVEM D,KN
				; 50    I=J
L50:	MOVEM J,I#
				; 102   RJ=I+.01
L102:	FLTR RJ,I		;FLOAT I, PUT IT IN RJ
	FADR RJ,[=0.1]	;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
				;	ALT=HGHT(JJ,RJ,Q,R)
	MOVE AL,-2(JJ)
	CAMN AL,1(JJ)
	JRST RET2
	MOVNS AL
	FADR AL,1(JJ)
	MOVE Y,-3(JJ)
	MOVNS D,Y
	FADR D,RJ
	FADR Y,(JJ)
	FMPR AL,D
	FDVR AL,Y
	FADR AL,-2(JJ)		;	Z=-10000
RET2:	MOVN Z,[=10000.0]	;	JK=-1
	SETO JK,		;	XALT=ALT+.001
	MOVE D,AL
	FADR D,[=0.001]
	MOVEM D,XALT#		;	ZALT=ALT
	MOVEM AL,ZALT#		; 400   DO 47 L=2,KK
	MOVE  L,SVQ 
L47:	ADDI L,3
	CAILE L,-2(KK)
	JRST L477	;	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
	CAME L,JJ
	SKIPGE 2(L)
	JRST L47
	CAML RJ,-3(L)
	JRST L475
	CAMLE RJ,(L)
	JRST L476
L475:	CAMGE RJ,(L)
	CAMG RJ,-3(L)
	JRST L47		;	X=HGHT(L,RJ,Q,R)
L476:	MOVE X,-2(L)
	CAMN X,1(L)
	JRST RET3
	MOVNS X
	FADR X,1(L)
	MOVE Y,-3(L)
	MOVNS D,Y
	FADR D,RJ
	FADR Y,(L)
	FMPR X,D
	FDVR X,Y
	FADR X,-2(L)		;	IF(X.GT.XALT)GO TO 47
RET3:	CAMG X,XALT		;	IF(X.LE.Z)GO TO 47
	CAMG X,Z
	JRST L47		;	Z=X
	MOVE Z,X		;	JK=L
	HRRZI JK,(L)		; 47    CONTINUE
	JRST L47		;	IF(JK)GO TO 48
L477:	JUMPL JK,L48	;	300   IF(ZALT-Z.GT..001.OR.I.NE.J)GO TO 59
	MOVN D,Z
	FADR D,ZALT
	CAMG D,[=0.001]
	CAME J,I
	JRST L59		;	JX=Q(JK)
	KIFIX D,(JK)		;	IF(JX.GT.KN)GO TO 60
	CAMLE D,KN
	JRST L60		;	JX=Q(JK-1)
	KIFIX D,-3(JK)		;	IF(JX.LT.KN)GO TO 59
	CAMGE D,KN
	JRST L59		; 60    L=JJ
L60:	MOVE L,JJ		;	JJ=JK
	MOVE JJ,JK		;	JK=L
	MOVE JK,L		;	KN=JX
	MOVEM D,KN		; 59    IF(ALT-Z.LT.2)GO TO 62
L59:	MOVN D,Z
	FADR D,AL
	CAMGE D,[=2.0]
	JRST L62
	FADR Z,[1.0]		;	Z=Z+1
				; 62    IF(JORD)GO TO 103
L62:	SKIPGE JORD
	JRST L103		;	X=Z
	MOVE X,Z		;	Z=ALT
	MOVE Z,AL		;	ALT=X
	MOVE AL,X		;	IF(JK.NE.NK.AND.ABS(ALT-Z).GT.5.)JA=3

	CAMN JK,NK#
	JRST L103
	MOVN D,Z
	FADR D,AL
	SKIPGE D
	MOVNS D
	CAMG D,[5.0]
	JRST L103
	HRRZI D,3
	HRRZM D,JA		; 103   CALL LINES(RJ,ALT,JA)
L103:	MOVEM RJ,SVRJ#
	MOVEM AL,SVAL#
	MOVEM Z,SVB#
  	HRRZI 16,SVAC
  	BLT 16,SVAC+15
	JSA 16,LINES
	JUMP SVRJ
	JUMP SVAL
	JUMP JA
				; 100   CALL LINES(RJ,Z,2)	
	JSA 16,LINES
	JUMP SVRJ
	JUMP SVB 
	JUMP [2]
  	HRLZI 16,SVAC
  	BLT 16,15
				;	NK=JK
	MOVEM JK,NK

				;	JORD=-JORD
	MOVNS JORD
				;	NE(JK)=1
	HRRZI D,1
	HRRZM D,2(JK)
				;	NE(JJ)=-1
	SETOM 2(JJ)		;	JA=2
	HRRZI D,2
	HRRZM D,JA		;	I=I+M
   	MOVE D,INCR		; THIS FORM OF FILLER INCR'S BY 2
	ADDB D,I		;	IF(I.LT.KN)GO TO 102
	CAMGE D,KN
	JRST L102		;	L=1
	HRRZI L,3		;	IF(KN.EQ.KL)L=-1
	MOVE D,KN
	CAMN D,KL
	HRROI L,-3		;	JJ=JJ+L
	ADD JJ,L		;	J=0
	SETZ J,			;	IF(L)J=-1
	SKIPGE L
	HRROI J,-3	;IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
	SKIPN 2(JJ)
	CAILE JJ,-2(KK)
	JRST L124
	ADD  D,INCR		; INCR'S BY 2
	FLTR D,D
	HRRZI HG,(JJ)
	ADD HG,J
	CAMLE D,(HG)
	JRST L124		;	J=I
	MOVE J,I		;	GO TO 52
	JRST L52		; 48    JA=3
L48:	HRRZI D,3
	HRRZM D,JA		; 43    J=LEFT+M
L43:	MOVE J,C
	ADD  J,INCR		;INCR'S BY 2
				;	IF(J.LE.LRT)GO TO 42
	CAMG J,LRT
	JRST L42
				;	IF(JCONT)GO TO 51
	SKIPGE JCONT
	JRST L51		;	END
	MOVE 16,SV16
	JRST FM6    
SVAC:	BLOCK 16


		;	SUBROUTINE LINES(A,B,L)
		;	COMMON/DST/BB,CC
   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
		;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
		;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
		;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
		;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
		;	1,(JJ2,JJ(2))
		;	DATA BB/.008/,CC/3.5/
 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
	
	M←2 ↔ NZ←3 ↔ K←4

LINES:	0		;	GO TO 23
DIST1:	SKIPGE R9
	JRST L23	;22	IF(JQ(1).NE.0)GO TO 23
	SKIPE PLTR+=27
	JRST L23	;	IF(CC.EQ.1000)GO TO 23
DIST:	MOVSI D,212764
	CAMN D,DST+1	;** FOR DISTORATION -- SEE ALSO FILLMS ***
	JRST L23	;	B=B*(CC-BB*ABS(A))
	MOVM D,@(16)
	FMPR D,DST	;BB IS DSD, CC IS DST+1
	FSBR D,DST+1
	FMPRM D,@1(16)
	MOVNS @1(16)	;23	IF(IPLT)GO TO 2
L23:	SKIPGE PLTR
	JRST L9
	MOVE	D,.COMM.+1	;IF(JA.EQ.44)RETURN
	CAIN	D,=44		;WON'T LOOK AT BARLINES FOR HEIGHT.
	JRA	16,3(16)
	MOVE	D,@1(16)
	CAMG	D,DPY+1
	JRST	L333
	MOVEM	D,DPY+1  ;  IF(B.LT.BOT)BOT=B
	JRA	16,3(16)
L333:	CAMG	D,DPY+2
	MOVEM	D,DPY+2
	JRA	16,3(16)  ;	IF(B.GT.TOP)TOP=B
			;2	IF(IPLT.EQ.-2)RETURN
L9:   	MOVE M,@(16)
	FMPR M,PLTR+2
	SKIPGE M
	FADR M,[-=1.0]
	FADR M,[=0.5]
	KIFIX M,M
	MOVEM M,MM#		;	N=ROFF(B*RHT)
	MOVE NZ,@1(16)
	FMPR NZ,PLTR+1
	SKIPGE NZ
	FADR NZ,[-=1.0]
	FADR NZ,[=0.5]
	KIFIX NZ,NZ
	MOVEM NZ,NN#		;8	CALL PLOT(M,N,L)
L8:	MOVE D,@2(16)
	MOVEM D,LL#
	JSA 16,PLOT
	JUMP MM
	JUMP NN
	JUMP LL			;	END
	JRA 16,3(16)

PLOTS:	0
	JRA	16,1(16)	; DUMMY ROUTINE

J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
Y←13↔ X←14↔ L←15↔ M←1
JPOS:	0		;C  BLACKS IN NOTES
IPOS:	0	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
IC:	0
KZ:	0
NOIR:	0    ;	COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
	MOVE	A,.COMM.+4		;EQUIVALENCE (PRE,IRN(1))
	FMPR	A,PLTR+2	;DATA BL/7.5/,BH/6.7/
;  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
  	JSA	16,ROFF		;IPOS=ROFF(RJQ(1)*DIS)
  	JUMP	A
	KIFIX A,A
	MOVEM	A,IPOS
	MOVE	A,.COMM.+2		;JPOS=ROFF(CENTR*RHT)
	FMPR	A,PLTR+1
	JSA	16,ROFF
	JUMP	A
	KIFIX A,A
;??	MOVE 	D,@(16)
;??	CAME	D,STF+8		;IF(RMINI.NE.RSTJ2)JPOS=JPOS+1
;??	AOS A	;TO PUSH MINI-NOTE UP ONE XGP NOTCH!!!! *******************
	MOVEM	A,JPOS		;SAVE FOR LATER
	MOVN	A,@(16)		;IF(-RMINI.EQ.PRE)GO TO 10
	CAMN	A,XRN
	JRST	NO10
	MOVEM	A,XRN		;PRE=-RMINI
	MOVE	D,[0.25]	;D=.25
	MOVE	B,[6.9]		;B=BH*RMINI*RHT ****WAS 6.7***
	FMPR	B,PLTR+1
	FMPR	B,@(16)
	MOVE	E,PLTR+2	;E=RMINI*DIS
	FMPR	E,@(16)
	MOVE	A,[7.6]		;A=BL*E **** WAS 7.5 ****
	FMPR	A,E
	KIFIX 15,A 		;IC=A
	MOVEM	15,IC
	FMPR	A,A		;A=A*A
	MOVN	E,B		;E=-B/4.
	FDVR	E,[=4.0]
	KIFIX	15,B		;K=B
	MOVEM	15,KZ
	FMPR	B,B		;B=B*B   USES EQUATION FOR ELLIPSE
	MOVEI	11,1		;N=1
	MOVEI	NX,2		;NX=2
	MOVN	J,KZ	;6	DO 1 J=-K,K
NO1:	MOVE	Y,J		;Y=J*J
	IMUL	Y,Y
	FLTR Y,Y   		;FLOAT
	MOVNS	Y		;X=SQRT(A-(A*Y)/B)
	FMPR	Y,A
	FDVR	Y,B
	FADR	Y,A
	JSA	16,SQRT
	JUMP	Y
	MOVE	L,E		;L=E-X
	FSBR	L,0
	KIFIX L,L
;;	MOVE	M,X		;M=X+E
;;	FADR	M,E
	FADR 0,E
	KIFIX 0,0	;  THE TWO SIDES OF THE LINE
	SKIPGE	11		;IF(N)CALL EXCH(L,M)
	EXCH	L,0
	MOVEM L,XRN-1(NX)
	MOVEM 0,XRN(NX)		;     C IS VERTICLE POS.
	ADDI	NX,2		;NX=NX+2
	FADR	E,D		;E=E+D    E IS TO TILT IT.
	MOVNS	11	;1	N=-N
	CAMGE	J,KZ
	AOJA	J,NO1		;LOOP BACK
NO10:	MOVE	J,IPOS	;10	CALL PLOT(IPOS+3,JPOS,3)
	ADDI	J,3
	JSA	16,PLOT
	JUMP	J
	JUMP 	JPOS
	JUMP	[3]
	MOVEI	11,2		;N=2  1ST LOC. OF ARRAY HAS "PRE"
	MOVE	L,IC		;L=IPOS+IC
	ADD	L,IPOS
	MOVN	M,KZ		;DO 11 M=-K,K
NO11:	MOVE	J,JPOS		;J=M+JPOS
	MOVEM	M,PLOTS
	ADD	J,M		;CALL PLOT(L+IRN(N),J,2)
	MOVE NX,XRN-1(11)
	ADD	NX,L
	JSA 	16,PLOT
	JUMP	NX
	JUMP	J
	JUMP	[2]	 	;CALL PLOT(L+IRN(N+1),J,2)
	MOVE NX,XRN(11)
	ADD	NX,L
	JSA	16,PLOT
	JUMP	NX
	JUMP	J
	JUMP	[2]
	ADDI	11,2		;11	N=N+2
	MOVE	M,PLOTS
	CAMGE	M,KZ
	AOJA	M,NO11
	JRA	16,1(16)

	END